// System Unit
// Utility Routines

(*************)
(* Interface *)
(*************)
{$IFDEF Include_Modules_Header}

 //--------------------------------
 // Fixed-Length Double-Linked list
 // For Semi-dynamic resource management in absence of a memory manager
 // NOTE: In order to use FLDL, the user must provide data structures
 //       exactly match the below structures!
 Type
  PFLDLItem = ^TFLDLItem;
  TFLDLItem = Record
   Data: Int64;
   Prev, Next: PFLDLItem;
  END;

  TFLDLHeader = Record
   MaxSize, MinFree: Cardinal;
   Head, Tail: PFLDLItem;
  END;

  TFLDL = Record
   Header: TFLDLHeader;
   List: Array[0..0] of TFLDLItem;
  END;

 Procedure FLDL_Init(Var List; Len: Cardinal);
 Function FLDL_Alloc(Var List): Cardinal;
 Procedure FLDL_Free(Var List; Idx: Cardinal);

 //--------------------------------
 // Data Movement

 Type RTLProc_Move = Procedure (Const Source; Var Dest; Count: Integer);
 Var Move: RTLProc_Move = NIL;
 Var MoveWChar: RTLProc_Move = NIL;

 Type RTLProc_FillChar = Procedure (Var Dest; Count: Integer; Value: ANSIChar);
 Var _FillChar: RTLProc_FillChar = NIL;

 Type RTLProc_FillWChar = Procedure (Var Dest; Count: Integer; Value: WideChar);
 Var FillWChar: RTLProc_FillWChar = NIL;

 //--------------------------------
 // Various RTL Utility Routines

 Procedure RTL_CardinalToHex8(ACardinal: Cardinal; ABuffer: PChar);
 Function RTL_PWideCharCopyN(Buffer, Source: PWideChar; MaxLen: Cardinal): Cardinal;
 Function RTL_PWideCharCopyNPtr(Buffer, Source: PWideChar; MaxLen: Cardinal): PWideChar;

 //==================
 // RTL Extensions
 //==================
 Type
  TRTLEx_Utils = Record
   Move: RTLProc_Move;
   MoveWChar: RTLProc_Move;
   _FillChar: RTLProc_FillChar;
   FillWChar: RTLProc_FillWChar;
  END;

 Procedure RTLExtend_Utils(Var Ex: TRTLEx_Utils);

{$ENDIF Include_Modules_Header}

(******************)
(* Implementation *)
(******************)
{$IFDEF Include_Modules_Implement}

 //--------------------------------
 // Internal utility functions

 Procedure _INT_NotImplemented;
  BEGIN
   Error(reUnimplement);
  END;

 //--------------------------------
 // Fixed-Length Double-Linked list
 Procedure FLDL_Init(Var List; Len: Cardinal);
  BEGIN
   With TFLDLHeader(List) do
    BEGIN
     MaxSize:= Len;
     MinFree:= 0;
     Head:= NIL;
     Tail:= NIL;
    END;

   FillChar(TFLDL(List).List[0], Sizeof(TFLDLItem)*Len, 0);
  END;

 Function FLDL_Alloc(Var List): Cardinal;
  BEGIN
   With TFLDL(List), Header do
    BEGIN
     While MinFree < MaxSize do
      IF List[MinFree].Data = 0
       then Break
       else Inc(MinFree);

     IF MinFree >= MaxSize
     then Error(reOutOfMemory);

     IF NOT Assigned(Head) then
      BEGIN
       Head:= @List[MinFree];
       Tail:= @List[MinFree];
      END
     else // Append at tail
      BEGIN
       Tail.Next:= @List[MinFree];
       List[MinFree].Prev:= Tail;
       Tail:= @List[MinFree];
      END;
     Result:= MinFree;
    END;
  END;

 Procedure FLDL_Free(Var List; Idx: Cardinal);
  BEGIN
   With TFLDL(List), Header do
    BEGIN
     IF Idx >= MaxSize
     then Error(reRangeError);

     With List[Idx] do
      BEGIN
       IF Assigned(Prev)
       then Prev.Next:= Next
       else Head:= Next;

       IF Assigned(Next)
       then Next.Prev:= Prev
       else Tail:= Prev;

       Data:= 0;
       Prev:= NIL;
       Next:= NIL;
      END;

     IF Idx < MinFree
     then MinFree:= Idx;
    END;
  END;

 //--------------------------------
 // Data Movement

 // Generic version, base on FastCode FillChar()
 // Count: number of bytes
 // Value: two byte pattern
 Procedure _INT_Generic_FillChar(Var Dest; count: Integer; Value: Word);
  ASM                           // Size = 144 Bytes
   CMP   EDX, 32
   JGE   @@Large
   MOV   [EAX+EDX-1], CH        // Fill Last Byte
   AND   EDX, -2                // No. of Words to Fill
   NEG   EDX
   LEA   EDX, [@@SmallFill + 60 + EDX * 2]
   JMP   EDX
   NOP
  @@SmallFill:
   MOV   [EAX+28], CX
   MOV   [EAX+26], CX
   MOV   [EAX+24], CX
   MOV   [EAX+22], CX
   MOV   [EAX+20], CX
   MOV   [EAX+18], CX
   MOV   [EAX+16], CX
   MOV   [EAX+14], CX
   MOV   [EAX+12], CX
   MOV   [EAX+10], CX
   MOV   [EAX+ 8], CX
   MOV   [EAX+ 6], CX
   MOV   [EAX+ 4], CX
   MOV   [EAX+ 2], CX
   MOV   [EAX   ], CX
  @@Done:
   RET
  @@Large:
   MOV   [EAX  ], CX            // Fill First 8 Bytes
   MOV   [EAX+2], CX
   MOV   [EAX+4], CX
   MOV   [EAX+6], CX
   SUB   EDX, 16
   FLD   QWORD PTR [EAX]
   FST   QWORD PTR [EAX+EDX]    // Fill Last 16 Bytes
   FST   QWORD PTR [EAX+EDX+8]
   MOV   ECX, EAX
   AND   ECX, 7                 // 8-Byte Align Writes
   SUB   ECX, 8
   SUB   EAX, ECX
   ADD   EDX, ECX
   ADD   EAX, EDX
   NEG   EDX
  @@Loop:
   FST   QWORD PTR [EAX+EDX]    // Fill 16 Bytes per Loop
   FST   QWORD PTR [EAX+EDX+8]
   ADD   EDX, 16
   JL    @@Loop
   FFREE ST(0)
   FINCSTP
  END;

 // Generic version, base on FastCode FastMove()
 Procedure _INT_Generic_Move(Const Source; Var Dest; Count: Integer);
  ASM                           // Size = 247 Bytes
   CMP     ECX, 32
   JA      @@LargeMove {Count > 32 or Count < 0}
   SUB     ECX, 8
   JG      @@SmallMove
  @@TinyMove: {0..8 Byte Move}
   MOV     ECX, DWORD PTR [@@JumpTable+32+ECX*4]
   JMP     ECX
   NOP
  @@JumpTable: {4-Byte Aligned}
   DD      @@Exit, @@M01, @@M02, @@M03, @@M04, @@M05, @@M06, @@M07, @@M08
  @@SmallMove: {9..32 Byte Move Aligned}
   FILD    QWORD PTR [EAX+ECX] {Load Last 8}
   FILD    QWORD PTR [EAX] {Load First 8}
   CMP     ECX, 8
   JLE     @@Small16
   FILD    QWORD PTR [EAX+8] {Load Second 8}
   CMP     ECX, 16
   JLE     @@Small24
   FILD    QWORD PTR [EAX+16] {Load Third 8}
   FISTP   QWORD PTR [EDX+16] {Save Third 8}
  @@Small24:
   FISTP   QWORD PTR [EDX+8] {Save Second 8}
  @@Small16:
   FISTP   QWORD PTR [EDX] {Save First 8}
   FISTP   QWORD PTR [EDX+ECX] {Save Last 8}
  @@Exit:
   RET
   NOP
   NOP
   NOP
  @@LargeForwardMove: {4-Byte Aligned}
   PUSH    EDX
   FILD    QWORD PTR [EAX] {First 8}
   LEA     EAX, [EAX+ECX-8]
   LEA     ECX, [ECX+EDX-8]
   FILD    QWORD PTR [EAX] {Last 8}
   PUSH    ECX
   NEG     ECX
   AND     EDX, -8 {8-Byte Align Writes}
   LEA     ECX, [ECX+EDX+8]
   POP     EDX
  @FwdLoop:
   FILD    QWORD PTR [EAX+ECX]
   FISTP   QWORD PTR [EDX+ECX]
   ADD     ECX, 8
   JL      @FwdLoop
   FISTP   QWORD PTR [EDX] {Last 8}
   POP     EDX
   FISTP   QWORD PTR [EDX] {First 8}
   RET
   NOP
   NOP
   NOP
  @@LargeMove: { Aligned }
   JNG     @@LargeDone {Count < 0}
   CMP     EAX, EDX
   JA      @@LargeForwardMove
   SUB     EDX, ECX
   CMP     EAX, EDX
   LEA     EDX, [EDX+ECX]
   JNA     @@LargeForwardMove
   SUB     ECX, 8 {Backward Move}
   PUSH    ECX
   FILD    QWORD PTR [EAX+ECX] {Last 8}
   FILD    QWORD PTR [EAX] {First 8}
   ADD     ECX, EDX
   AND     ECX, -8 {8-Byte Align Writes}
   SUB     ECX, EDX
  @BwdLoop:
   FILD    QWORD PTR [EAX+ECX]
   FISTP   QWORD PTR [EDX+ECX]
   SUB     ECX, 8
   JG      @BwdLoop
   POP     ECX
   FISTP   QWORD PTR [EDX] {First 8}
   FISTP   QWORD PTR [EDX+ECX] {Last 8}
  @@LargeDone:
   RET
  @@M01:
   MOV     CL, [EAX]
   MOV     [EDX], CL
   RET
  @@M03:
   MOV     CL, [EAX+2]
   MOV     [EDX+2], CL
  @@M02:
   MOV     CX, [EAX]
   MOV     [EDX], CX
   RET
  @@M05:
   MOV     CL, [EAX+4]
   MOV     [EDX+4], CL
  @@M04:
   MOV     ECX, [EAX]
   MOV     [EDX], ECX
   RET
  @@M06:
   MOV     ECX, [EAX]
   MOV     AX, [EAX+4]
   MOV     [EDX], ECX
   MOV     [EDX+4], AX
   RET
  @@M07:
   MOV     ECX, [EAX]
   MOV     EAX, [EAX+3]
   MOV     [EDX], ECX
   MOV     [EDX+3], EAX
   RET
  @@M08:
   FILD    QWORD PTR [EAX]
   FISTP   QWORD PTR [EDX]
  END;

 Procedure _RTL_MoveByte(Const Source; Var Dest; Count: Integer);
  ASM
   CMP  EAX, EDX
   JNE  _INT_Generic_Move
  END;

 Procedure _RTL_MoveWChar(Const Source; Var Dest; Count: Integer);
  ASM
   SHL  Count, 1
   CMP  EAX, EDX
   JNE  _INT_Generic_Move
  END;

 Procedure _RTL_FillChar(Var Dest; Count: Integer; Value: ANSIChar);
  ASM
   CMP EDX, 0
   MOV  CH, CL
   JG  _INT_Generic_FillChar
  END;

 Procedure _RTL_FillWChar(Var Dest; Count: Integer; Value: WideChar);
  ASM
   SAL  EDX, 1
   JG  _INT_Generic_FillChar
  END;

 //--------------------------------
 // Various RTL Utility Routines

 Procedure RTL_CardinalToHex8(ACardinal: Cardinal; ABuffer: PChar);
  Const _INT_HexTable: Array[0..15] of Char = '0123456789ABCDEF';
  Var Counter: Cardinal;
  BEGIN
   For Counter:= 7 downto 0 do
    BEGIN
     ABuffer[Counter]:= _INT_HexTable[ACardinal AND $F];
     ACardinal:= ACardinal SHR 4;
    END;
  END;

 Function RTL_PWideCharCopyN(Buffer, Source: PWideChar; MaxLen: Cardinal): Cardinal;
  BEGIN
   Result:= _WIN_LStrLen(Source);
   IF Result > MaxLen then Result:= MaxLen;
   MoveWChar(Source^, Buffer^, Result);
   Buffer[Result]:= #0;
  END;

 Function RTL_PWideCharCopyNPtr(Buffer, Source: PWideChar; MaxLen: Cardinal): PWideChar;
  BEGIN
   Result:= @Buffer[RTL_PWideCharCopyN(Buffer, Source, MaxLen)];
  END;

 //==================
 // RTL Extensions
 //==================

 Procedure _INT_RTL_DoEx(Var FuncPtr; Var NewFuncPtr);
  ASM
   MOV  ECX, [NewFuncPtr]
   TEST ECX, ECX
   JZ   @Done
   XCHG [FuncPtr], ECX
   MOV  [NewFuncPtr], ECX
  @Done:
  END;

 Procedure RTLExtend_Utils(Var Ex: TRTLEx_Utils);
  BEGIN
   _INT_RTL_DoEx(@Move, @Ex.Move);
   _INT_RTL_DoEx(@MoveWChar, @Ex.MoveWChar);
   _INT_RTL_DoEx(@_FillChar, @Ex._FillChar);
   _INT_RTL_DoEx(@FillWChar, @Ex.FillWChar);
  END;

 Procedure _INT_Utils_Init;
  BEGIN
   Move:= _RTL_MoveByte;
   MoveWChar:= _RTL_MoveWChar;
   _FillChar:= _RTL_FillChar;
   FillWChar:= _RTL_FillWChar;
  END;

{$ENDIF Include_Modules_Implement}
(******************)
(* Initialization *)
(******************)
{$IFDEF Include_Modules_Initialize}
{$ENDIF Include_Modules_Initialize}
(****************)
(* Finalization *)
(****************)
{$IFDEF Include_Modules_Finalize}
{$ENDIF Include_Modules_Finalize}
